;;;;=========================================================================
;;;;=========================================================================
;;;;
;;;; This file provides various functions for parsing and formatting the
;;;; communication between the search and rescue simulator and the client.
;;;;
;;;; DO NOT MODIFY THE CONTENTS OF THIS FILE -- it may be overwritten in 
;;;; later releases of the Search and Rescue simulator.
;;;;
;;;; Authors: Eric Eaton, Aaron Curtis
;;;;
;;;;=========================================================================
;;;;=========================================================================


(load "s-xml/package.lisp")
(load "s-xml/xml.lisp")
(load "s-xml/dom.lisp")
(load "s-xml/sxml-dom.lisp")
(load "s-base64/package.lisp")
(load "s-base64/base64.lisp")



(defstruct mapcell
  (coordinates)
  (id)
  (adjacent_mapcells)
  (marker))




;;;;=========================================================================
;;;;=========================================================================
;;;;
;;;; Server/Client Communication Handling Functions
;;;;
;;;;=========================================================================
;;;;=========================================================================


;;===================================================================
;; Function:  action-to-xml
;;
;; Converts an action structure to xml that can be understood by the
;; server.
;;
;; Arguments:
;;  action_struct - an action data structure
;;
;; Returns:
;;  a string containing xml data that can be sent to the server
;;===================================================================
(defmethod action-to-xml ((action_struct action))

    (if (null (action-direction action_struct))
        (format nil "<action> <name> ~A </name> </action>"
            (action-name action_struct))
        (format nil "<action> <name> ~A </name> <direction> ~A </direction> </action>"
            (action-name action_struct)
            (action-direction action_struct))))



;;===================================================================
;; Function:  register-agent-to-xml
;;
;; Generates the XML string to register the agent with the controller.
;;
;; Arguments:
;;  agent_name - the name of the agent
;;  image_filename - the filename of the image to represent the agent
;;
;; Returns:
;;  a string containing xml data that can be sent to the server
;;===================================================================
(defun register-agent-to-xml (agent_name &optional image_filename &aux encoded_image)
    (check-type agent_name string "a string")

    ;; encode the image for transmission
    (if (not (null image_filename))
	(progn
	  (check-type image_filename string "the filename of the image to represent the agent")
	  (setf encoded_image (base64-encode-file image_filename))))
    

    ;; return the registration command
    (if (null encoded_image)
	(format nil "<register_agent> <name> ~A </name> </register_agent>" agent_name)
        (format nil "<register_agent><name>~A</name><image>~A</image></register_agent>" agent_name encoded_image)))


;;==================================================================
;; Function: base64-encode-file
;;
;; Encodes the file into base64 format
;;
;; Arguments:
;;  filename - the name of the file to encode
;;
;; Return:
;;  the file encoded in base64 format, or nil if this could not be accomplished
;;==================================================================
(defun base64-encode-file (filename &aux encoded_file)

  (check-type filename string "a filename")

  (unwind-protect

      ;; load the file and convert it to base64
      (let* ((stream (open filename :element-type 'unsigned-byte))
	     (data   (make-array (file-length stream))))
	(read-sequence data stream)
	(setf encoded_file 
	      (with-output-to-string (encoded_file)
	         (s-base64:encode-base64-bytes data encoded_file nil))))

      ;; return nil if there was an error encoding the file
      (if (null encoded_file)
	  (return-from base64-encode-file nil))
      (return-from base64-encode-file encoded_file)))


;;===================================================================
;; Function:  parse-score
;;
;; Parses the final score information sent by the server at the
;; end of the simulation.  Data is expected in the format:
;;  <finalscore></finalscore>
;;
;; Arguments:
;;  input - an xml string
;;
;; Returns:
;;  integer representing the final score, or nil if something went
;;  wrong
;;===================================================================
(defun parse-score (input)
    (check-type input string "an XML string")
    (let* ((score-node (s-xml:parse-xml-string input :output-type :sxml))
           (score-string (cadr score-node)))
        (if (and (is-node score-node ':|finalscore|) (not (null score-string)))
            (read-from-string score-string)
            nil)))


;;===================================================================
;; Function:  parse-perceptions
;;
;; Parses the data sent from the server at each time step of the
;; simulation.  This will include the status of the agent's last
;; action, and information about the area visible to the agent.
;; Data is expected in the following form:
;;
;; <perceptions>
;;   <action>
;;     <name>NAME</name>
;;     <direction>DIR</direction>
;;     <time>TIME</time>
;;     <status>STATUS</status>
;;   </action>
;;   <agent>
;;     <coordinates><x>X</x><y>Y</y></coordinates>
;;     <name>NAME</name>
;;     <description>DESC</description>
;;   </agent>
;;   <cell>
;;     <coordinates><x>X</x><y>Y</y></coordinates>
;;     <marker>foo</marker>
;;     <wall>SOUTH</wall>
;;     ...
;;     <occupant>
;;       <object>
;;         <coordinates><x>X</x><y>Y</y></coordinates>
;;         <name>NAME</name>
;;         <description>DESC</description>
;;       </object>
;;     </occupant>
;;   </cell>
;;   ...
;; </perceptions>
;;
;; Arguments:
;;  input - an xml string
;;
;; Returns:
;;  a perceptions structure representing the data
;;===================================================================
(defun parse-perceptions (input)
    (check-type input string "an XML string")
    (let* ((rootnode    (s-xml:parse-xml-string input :output-type :sxml)))
      (parse-perceptions-from-xml rootnode)))
           




;;===================================================================
;; Function:  process-initial-knowledge
;;
;; Parses the initial map xml data sent from the server.  This will
;; include static information about the world (map layout, goal
;; locations).  Data is expected in the following form:
;;
;; <map>
;;   ...
;; </map>
;;
;; Arguments:
;;  input - an xml string
;;
;; Returns:
;;
;;===================================================================
(defun process-initial-knowledge (input)
    (check-type input string "an XML string")

    (let ((xmlnode (s-xml:parse-xml-string input :output-type :sxml))
	  (mapcells nil))

      ;; parse the XML map spec into a list of mapcells
      (setf mapcells (parse-map-from-xml xmlnode))

      ;; initialize the map from the parsed XML map spec
      (initialize-map mapcells)))



;;===================================================================
;; Function:  initialize-map
;;
;; Given a list of mapcells, initializes the *adjacent_coordinates* and
;; *marked_coordinates* hash tables
;;
;; Arguments:
;;  mapcells - a list of mapcells
;;
;;===================================================================
(defun initialize-map(mapcells &aux (id_to_coordinates (make-hash-table :test 'equalp)))

  ;; reinitialize the two main data structures
  (setf *adjacent_coordinates* (make-hash-table :test 'equalp))
  (setf *marked_coordinates* (make-hash-table :test 'equalp))
			       
  ;; loop through the mapcells to initialize the hash of cell id to coordinates
  (loop for x in mapcells do
	(setf (gethash (mapcell-id x) id_to_coordinates) (mapcell-coordinates x)))

  ;; loop again through the mapcells, processing each mapcell and resolving references
  (loop for x in mapcells do

	;; convert the adjacent cell references to coordinates and hash those as the adjacent cells
	(setf (gethash (mapcell-coordinates x) *adjacent_coordinates*)
	      (remove-if #'null 
			       (loop for adjCellID 
				     in (mapcell-adjacent_mapcells x) 
				     collect (gethash adjCellID id_to_coordinates))))
	
	;; keep track of the various markers
	(if (not (null (mapcell-marker x)))
	    (let* ((marker (mapcell-marker x))
		  (similar_cells (gethash marker *marked_coordinates*)))
	      (setf (gethash marker *marked_coordinates*) (append similar_cells (list (mapcell-coordinates x)))))))

  t)









;;;;=========================================================================
;;;;=========================================================================
;;;;
;;;; XML Parser Functions
;;;;
;;;;=========================================================================
;;;;=========================================================================


;;===================================================================
;; Function:  parse-perceptions-from-xml
;;
;; Parses the perceptions from an S-XML DOM.
;; Data is expected in the following form:
;;
;;   <perceptions>
;;     <action> ... </action>
;;     <agent> ... </agent>
;;     <cell> ... </cell>
;;     <cell> ... </cell>
;;     ...
;;   </perceptions>
;;
;; Arguments:
;;  node - the map node
;;
;; Returns:
;;  a list of mapcells
;;
;;===================================================================
(defun parse-perceptions-from-xml (node &aux actionstatus self (shortrange nil) longrange)

  (if (not (is-node node ':|perceptions|))
      (return-from parse-perceptions-from-xml nil))

  (setf actionstatus (parse-action-status-from-xml (get-child node ':|action|)))
  (setf self (parse-agent-from-xml (get-child node ':|agent|)))
  (setf longrange (loop for x in (get-children node ':|cell|) 
			collect (parse-cell-from-xml x)))

  (if (and (not (null actionstatus)) 
	   (object-p (status actionstatus)))
      (setf shortrange (status actionstatus)))
    

  (make-perceptions
   :last_action actionstatus
   :self_sensors self
   :shortrange_sensors shortrange
   :longrange_sensors longrange))
	 


;;===================================================================
;; Function:  parse-map-from-xml
;;
;; Parses the map from an S-XML DOM.
;; Data is expected in the following form:
;;
;;   <map>
;;     <mapcell> ... </mapcell>
;;     <mapcell> ... </mapcell>
;;     ...
;;   </map>
;;
;; Arguments:
;;  node - the map node
;;
;; Returns:
;;  a list of mapcells
;;
;;===================================================================
(defun parse-map-from-xml (node)

  (if (not (is-node node ':|map|))
      (return-from parse-map-from-xml nil))

  ;; collect and return a list of the cell structures
  (loop for x in (get-children node ':|mapcell|) collect (parse-mapcell-from-xml x)))





;;===================================================================
;; Function:  parse-mapcell-from-xml
;;
;; Parses a cell from an S-XML DOM.
;; Data is expected in the following form:
;;
;;   <mapcell id="cell_ID_0">
;;     <coordinates> ... </coordinates>
;;     <marker> m </marker>
;;     <adjacentcells>
;;       <mapcell id="cell_ID_1"/>
;;       <mapcell id="cell_ID_2"/>
;;     </adjacentcells>
;;   </mapcell>
;;
;; Arguments:
;;  node - the cell node
;;
;; Returns:
;;  a mapcell structure of this cell
;;
;;===================================================================
(defun parse-mapcell-from-xml (node &aux (adjacent_cells nil))
  (if (not (is-node node ':|mapcell|))
      (return-from parse-mapcell-from-xml nil))

  ;; get a list of all the cells in the adjacent cells list
  (setf adjacent_cells (get-children (get-child node ':|adjacentcells|) 
				     ':|mapcell|))

  (make-mapcell
   :coordinates (parse-coordinates-from-xml (get-child node ':|coordinates|))
   :id (get-attribute node ':|id|)
   :marker (get-child-value node ':|marker|)
   :adjacent_mapcells (loop for x in adjacent_cells collect (get-attribute x ':|id|))))




;;===================================================================
;; Function:  parse-goals-from-xml
;;
;; Creates a list of goals from an xml goal specification in the S-XML DOM
;; of the format 
;;    <goals>
;;      <coordinates> ... </coordinates>
;;      <coordinates> ... </coordinates>
;;      ...
;;    </goals>
;;
;; Arguments:
;;  node - the parent node in the DOM
;;
;; Returns:
;;  a list of the goals contained in the node
;;===================================================================
(defun parse-goals-from-xml (node &aux (goals nil))
  (if (not (is-node node ':|goals|))
      (return-from parse-goals-from-xml nil))

  ;; The goal information will be processed into a list of
  ;; coordinates structures, one for each goal location.
  (mapcar
       #'(lambda (coordsnode)
	   (setf goals (append goals 
			       (list (parse-coordinates-from-xml coordsnode)))))
       (get-children node ':|coordinates|))

  (return-from parse-goals-from-xml goals))



;;===================================================================
;; Function:  parse-mapcell-from-xml
;;
;; Parses a cell from an S-XML DOM.
;; Data is expected in the following form:
;;
;;   <mapcell id="cell_ID_0">
;;     <coordinates> ... </coordinates>
;;     <marker> m </marker>
;;     <adjacentcells>
;;       <mapcell id="cell_ID_1">
;;       <mapcell id="cell_ID_2">
;;     </adjacentcells>
;;   </cell>
;;
;; Arguments:
;;  node - the cell node
;;
;; Returns:
;;  a mapcell structure of this cell
;;
;;===================================================================
(defun parse-cell-from-xml (node &aux (adjacent_cells nil))
  (if (not (is-node node ':|cell|))
      (return-from parse-cell-from-xml nil))

  (make-cell
   :coordinates (parse-coordinates-from-xml (get-child node ':|coordinates|))
   :marker (get-child-value node ':|marker|)
   :walls (loop for x in (get-children node ':|wall|) collect (get-value x))
   :occupant (parse-occupant-from-xml (get-child node ':|occupant|))))



;;===================================================================
;; Function:  parse-occupant-from-xml
;;
;; Retrieves the structure representing the contents of the occupant node in the S-XML DOM.
;;
;; Arguments:
;;  node - the occupant node in the DOM
;;
;; Returns:
;;  the structure representing the occupant
;;===================================================================
(defun parse-occupant-from-xml (node &aux occupant)
  (if (not (is-node node ':|occupant|))
      (return-from parse-occupant-from-xml nil))

  (setf occupant (parse-object-from-xml (get-value node)))
  (if (not (null occupant))
      (return-from parse-occupant-from-xml occupant))

  (parse-agent-from-xml (get-value node)))



;;===================================================================
;; Function:  parse-action-status-from-xml
;;
;; Creates an action-status structure from the first action-status node under a given parent in the S-XML DOM.
;;
;; Arguments:
;;  node - the parent node in the DOM
;;
;; Returns:
;;  a new action-status structure populated from the DOM node, or NIL if
;;  no matching node was found
;;===================================================================
(defun parse-action-status-from-xml (node &aux status)

  (if (not (is-node node ':|action|))
      (return-from parse-action-status-from-xml nil))

  ;; check if the status field has a more complex structure inside it
  (let* ((status-node (get-child node ':|status|))
	 (status-value (get-value status-node)))
    (cond 

     ;; if the status-node doesn't have any children, its value is a primitive
     ((not (has-child status-node))
      (setf status status-value))

     ;; try to parse out an object
     ((not (null (setf status (parse-object-from-xml status-value)))))

     ;; try to parse out an agent
     ((not (null (setf status (parse-agent-from-xml status-value)))))
    
     ;; if that didn't work, the status structure is unknown
     (t (setf status status-value))))
    
  
  (make-action-status
   :action (make-action
	    :name      (get-child-value node ':|name|)
	    :direction (get-child-value node ':|direction|))
   :timestamp   (parse-integer (get-child-value node ':|time|))
   :status status))



;;===================================================================
;; Function:  parse-agent-from-xml
;;
;; Creates an agent structure from the first agent node under a given parent in the S-XML DOM.
;;
;; Arguments:
;;  node - the parent node in the DOM
;;
;; Returns:
;;  a new agent structure populated from the DOM node, or NIL if
;;  no matching node was found
;;===================================================================
(defun parse-agent-from-xml (node &aux (child-node nil))

  (if (not (is-node node ':|agent|))
      (return-from parse-agent-from-xml nil))
  
  (make-agent
   :coordinates    (parse-coordinates-from-xml (get-child node ':|coordinates|))
   :name           (get-child-value node ':|name|)
   :description    (parse-feature-vector-from-xml (get-child (get-child node ':|description|) ':|featurevector|))))


;;===================================================================
;; Function:  parse-object-from-xml
;;
;; Creates an object structure from the first object node under a given parent in the S-XML DOM.
;;
;; Arguments:
;;  node - the parent node in the DOM
;;
;; Returns:
;;  a new object structure populated from the DOM node, or NIL if
;;  no matching node was found
;;===================================================================
(defun parse-object-from-xml (node)

  (if (not (is-node node ':|object|))
      (return-from parse-object-from-xml nil))
  
  (make-object
   :coordinates    (parse-coordinates-from-xml (get-child node ':|coordinates|))
   :name           (get-child-value node ':|name|)
   :description    (parse-feature-vector-from-xml (get-child (get-child node ':|description|) ':|featurevector|))))



;;===================================================================
;; Function:  parse-feature-vector-from-xml
;;
;; Parses a feature vector from an S-XML DOM.
;; Data is expected in the following form:
;;
;;   <featurevector>
;;     <value> value1 </value>
;;     <value> value2 </value>
;;     ...
;;   </featurevector>
;;
;; Arguments:
;;  node - the cell node
;;
;; Returns:
;;  a list of the feature vector's values in-order
;;
;;===================================================================
(defun parse-feature-vector-from-xml (node)
  (if (not (is-node node ':|featurevector|))
      (return-from parse-feature-vector-from-xml nil))

  (loop for x in (get-children node ':|value|) collect (get-value x)))



;;===================================================================
;; Function:  parse-coordinates-from-xml
;;
;; Creates a coordinates structure from a coordinates element in the
;; S-XML DOM.
;;
;; Arguments:
;;  node - the coordinates node from the DOM
;;
;; Returns:
;;  a new cell structure populated with the values from the DOM node
;;===================================================================
(defun parse-coordinates-from-xml (node)

  (if (not (is-node node ':|coordinates|))
      (return-from parse-coordinates-from-xml nil))

  (make-coordinates
   :x (parse-integer (get-child-value node ':|x|))
   :y (parse-integer (get-child-value node ':|y|))))






;;;;================================================================
;;;;================================================================
;;;;
;;;; XML Helper Functions
;;;;
;;;;================================================================
;;;;================================================================


;;===================================================================
;; Function:  is-node
;;
;; Helper function to determine whether the top level node in
;; the S-XML DOM matches the name.  The function tests if the node
;; is of the format:
;;   <name>foo</name>
;;
;; Arguments:
;;  node - the parent node in the DOM
;;  name - name of the node to match, as a keyword
;;               (':|nodename|)
;; Returns:
;;  t if the node matches the name, nil otherwise
;;===================================================================
(defun is-node (node name)
  (equal name (car node)))


;;===================================================================
;; Function:  get-value
;;
;; Helper function to retrieve the value of the node in
;; the S-XML DOM.
;;
;; Arguments:
;;  node - the parent node in the DOM

;; Returns:
;;  the value of the node
;;===================================================================
(defun get-value (node)
    (cadr node))


;;===================================================================
;; Function:  get-child-value
;;
;; Helper function to retrieve the value of a single child node in
;; the S-XML DOM.  The child node is expected to have the format:
;;   <node>foo</node>
;;
;; Arguments:
;;  node - the parent node in the DOM
;;  child-name - name of the child node to search for, as a keyword
;;               (':|mynode|)
;; Returns:
;;  Text value stored under the child node, provided it
;;  was found and was formatted as expected.  Otherwise, NIL.
;;===================================================================
(defun get-child-value (node child-name)
    (get-value (get-child node child-name)))



;;===================================================================
;; Function:  get-attribute
;;
;; Helper function to retrieve an attribute value from the S-XML DOM.
;;
;; Arguments:
;;  node - the DOM node containing the attribute
;;  att-name - name of the attribute as a keyword (':|myattribute|)
;;
;; Returns:
;;  value of the specified attribute (as a string), or NIL if it
;;  was not found
;;===================================================================
(defun get-attribute (node att-name)
    (let ((attributes (get-child node ':@)))
        (if (not (null attributes))
            (cadr (get-child attributes att-name)))))

;;===================================================================
;; Function:  has-child
;;
;; Helper function to determine whether a node in the S-XML DOM 
;; has children.
;;
;; Arguments:
;;  node - the parent node in the DOM
;;
;; Returns:
;;  t if the node has children, or NIL otherwise
;;===================================================================
(defun has-child (node)
  (listp (get-value node)))

;;===================================================================
;; Function:  get-child
;;
;; Helper function to retrieve a child node in the S-XML DOM.
;;
;; Arguments:
;;  node - the parent node in the DOM
;;  child-name - name of the child node to search for, as a keyword
;;               (':|mynode|)
;; Returns:
;;  the first child node in the DOM with the specified name, or NIL
;;  if it was not found
;;===================================================================
(defun get-child (node child-name)
    (find-if
        #'(lambda (child-node)
            (progn
            (equal (car child-node) child-name)))
        (cdr node)))



;;===================================================================
;; Function:  get-children
;;
;; Helper function to retrieve all child nodes of a specified type
;; from a node in the S-XML DOM.
;;
;; Arguments:
;;  node - the parent node in the DOM
;;  child-name - name of the child node to search for, as a keyword
;;               (':|mynode|)
;; Returns:
;;  a list of all child nodes in the DOM with the specified name,
;;  possibly NIL if none were found
;;===================================================================
(defun get-children (node child-name)
    (let ((children nil))
        (mapcar
            #'(lambda (x)
                ;; Note - sometimes if the node has no children, a child
                ;; might show up anyway as " ".  This makes bad things
                ;; happen if not checked for.

                (if (and (listp x) (equal (car x) child-name))
                    (setf children
                        (nconc children (list x)))))
            (cdr node))
        (return-from get-children children)))



